home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
001-025
/
disk_003
/
xlisp
/
xlio.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-05-06
|
3KB
|
150 lines
/* xlio - xlisp i/o routines */
#include "xlisp.h"
/* external variables */
extern int xlplevel;
extern int xlfsize;
extern NODE *xlstack;
extern NODE *s_stdin;
extern int xldebug;
extern int prompt;
/* xlgetc - get a character from a file or stream */
int xlgetc(fptr)
NODE *fptr;
{
NODE *lptr,*cptr;
FILE *fp;
int ch;
/* check for input from nil */
if (fptr == NIL)
ch = EOF;
/* otherwise, check for input from a stream */
else if (consp(fptr)) {
if ((lptr = car(fptr)) == NIL)
ch = EOF;
else {
if (!consp(lptr) ||
(cptr = car(lptr)) == NIL || !fixp(cptr))
xlfail("bad stream");
if (rplaca(fptr,cdr(lptr)) == NIL)
rplacd(fptr,NIL);
ch = cptr->n_int;
}
}
/* otherwise, check for a buffered file character */
else if (ch = fptr->n_savech)
fptr->n_savech = 0;
/* otherwise, get a new character */
else {
/* get the file pointer */
fp = fptr->n_fp;
/* prompt if necessary */
if (prompt && fp == stdin) {
/* print the debug level */
if (xldebug)
printf("%d:",xldebug);
/* print the nesting level */
if (xlplevel > 0)
printf("%d",xlplevel);
/* print the prompt */
printf("> ");
prompt = FALSE;
}
/* get the character */
if (((ch = getc(fp)) == '\n' || ch == EOF) && fp == stdin)
prompt = TRUE;
/* check for input abort */
if (fp == stdin && ch == '\007') {
putchar('\n');
xlabort("input aborted");
}
}
/* return the character */
return (ch);
}
/* xlpeek - peek at a character from a file or stream */
int xlpeek(fptr)
NODE *fptr;
{
NODE *lptr,*cptr;
int ch;
/* check for input from nil */
if (fptr == NIL)
ch = EOF;
/* otherwise, check for input from a stream */
else if (consp(fptr)) {
if ((lptr = car(fptr)) == NIL)
ch = EOF;
else {
if (!consp(lptr) ||
(cptr = car(lptr)) == NIL || !fixp(cptr))
xlfail("bad stream");
ch = cptr->n_int;
}
}
/* otherwise, get the next file character and save it */
else
ch = fptr->n_savech = xlgetc(fptr);
/* return the character */
return (ch);
}
/* xlputc - put a character to a file or stream */
xlputc(fptr,ch)
NODE *fptr; int ch;
{
NODE *oldstk,lptr;
/* count the character */
xlfsize++;
/* check for output to nil */
if (fptr == NIL)
;
/* otherwise, check for output to a stream */
else if (consp(fptr)) {
oldstk = xlsave(&lptr,NULL);
lptr.n_ptr = newnode(LIST);
rplaca(lptr.n_ptr,newnode(INT));
car(lptr.n_ptr)->n_int = ch;
if (cdr(fptr))
rplacd(cdr(fptr),lptr.n_ptr);
else
rplaca(fptr,lptr.n_ptr);
rplacd(fptr,lptr.n_ptr);
xlstack = oldstk;
}
/* otherwise, output the character to a file */
else
putc(ch,fptr->n_fp);
}
/* xlflush - flush the input buffer */
int xlflush()
{
if (!prompt)
while (xlgetc(s_stdin->n_symvalue) != '\n')
;
}